home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / BETACF.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  857b  |  39 lines
  1. FUNCTION betacf(a,b,x: real): real;
  2. LABEL 1;
  3. CONST
  4.    itmax=100;
  5.    eps=3.0e-7;
  6. VAR
  7.    tem,qap,qam,qab,em,d: real;
  8.    bz,bpp,bp,bm,az,app: real;
  9.    am,aold,ap: real;
  10.    m: integer;
  11. BEGIN
  12.    am := 1.0;
  13.    bm := 1.0;
  14.    az := 1.0;
  15.    qab := a+b;
  16.    qap := a+1.0;
  17.    qam := a-1.0;
  18.    bz := 1.0-qab*x/qap;
  19.    FOR m := 1 TO itmax DO BEGIN
  20.       em := m;
  21.       tem := em+em;
  22.       d := em*(b-m)*x/((qam+tem)*(a+tem));
  23.       ap := az+d*am;
  24.       bp := bz+d*bm;
  25.       d := -(a+em)*(qab+em)*x/((a+tem)*(qap+tem));
  26.       app := ap+d*az;
  27.       bpp := bp+d*bz;
  28.       aold := az;
  29.       am := ap/bpp;
  30.       bm := bp/bpp;
  31.       az := app/bpp;
  32.       bz := 1.0;
  33.       IF ((abs(az-aold)) < (eps*abs(az))) THEN GOTO 1
  34.    END;
  35.    writeln('pause in BETACF');
  36.    writeln('a or b too big, or itmax too small'); readln;
  37. 1:   betacf := az
  38. END;
  39.